home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / lib / tcl / text.tcl < prev    next >
Text File  |  1992-07-16  |  3KB  |  113 lines
  1. # text.tcl --
  2. #
  3. # This file contains Tcl procedures used to manage Tk entries.
  4. #
  5. # $Header: /user6/ouster/wish/scripts/RCS/text.tcl,v 1.2 92/07/16 16:26:33 ouster Exp $ SPRITE (Berkeley)
  6. #
  7. # Copyright 1992 Regents of the University of California
  8. # Permission to use, copy, modify, and distribute this
  9. # software and its documentation for any purpose and without
  10. # fee is hereby granted, provided that this copyright
  11. # notice appears in all copies.  The University of California
  12. # makes no representations about the suitability of this
  13. # software for any purpose.  It is provided "as is" without
  14. # express or implied warranty.
  15. #
  16.  
  17. # The procedure below is invoked when dragging one end of the selection.
  18. # The arguments are the text window name and the index of the character
  19. # that is to be the new end of the selection.
  20.  
  21. proc tk_textSelectTo {w index} {
  22.     global tk_priv
  23.  
  24.     case $tk_priv(selectMode) {
  25.     char {
  26.         if [$w compare $index < anchor] {
  27.         set first $index
  28.         set last anchor
  29.         } else {
  30.         set first anchor
  31.         set last [$w index $index+1c]
  32.         }
  33.     }
  34.     word {
  35.         if [$w compare $index < anchor] {
  36.         set first [$w index "$index wordstart"]
  37.         set last [$w index "anchor wordend"]
  38.         } else {
  39.         set first [$w index "anchor wordstart"]
  40.         set last [$w index "$index wordend"]
  41.         }
  42.     }
  43.     line {
  44.         if [$w compare $index < anchor] {
  45.         set first [$w index "$index linestart"]
  46.         set last [$w index "anchor lineend + 1c"]
  47.         } else {
  48.         set first [$w index "anchor linestart"]
  49.         set last [$w index "$index lineend + 1c"]
  50.         }
  51.     }
  52.     }
  53.     $w tag remove sel 0.0 $first
  54.     $w tag add sel $first $last
  55.     $w tag remove sel $last end
  56. }
  57.  
  58. # The procedure below is invoked to backspace over one character in
  59. # a text widget.  The name of the widget is passed as argument.
  60.  
  61. proc tk_textBackspace w {
  62.     $w delete insert-1c insert
  63. }
  64.  
  65. # The procedure below compares three indices, a, b, and c.  Index b must
  66. # be less than c.  The procedure returns 1 if a is closer to b than to c,
  67. # and 0 otherwise.  The "w" argument is the name of the text widget in
  68. # which to do the comparison.
  69.  
  70. proc tk_textIndexCloser {w a b c} {
  71.     set a [$w index $a]
  72.     set b [$w index $b]
  73.     set c [$w index $c]
  74.     if [$w compare $a <= $b] {
  75.     return 1
  76.     }
  77.     if [$w compare $a >= $c] {
  78.     return 0
  79.     }
  80.     scan $a "%d.%d" lineA chA
  81.     scan $b "%d.%d" lineB chB
  82.     scan $c "%d.%d" lineC chC
  83.     if {$chC == 0} {
  84.     incr lineC -1
  85.     set chC [string length [$w get $lineC.0 $lineC.end]]
  86.     }
  87.     if {$lineB != $lineC} {
  88.     return [expr {($lineA-$lineB) < ($lineC-$lineA)}]
  89.     }
  90.     return [expr {($chA-$chB) < ($chC-$chA)}]
  91. }
  92.  
  93. # The procedure below is called to reset the selection anchor to
  94. # whichever end is FARTHEST from the index argument.
  95.  
  96. proc tk_textResetAnchor {w index} {
  97.     global tk_priv
  98.     if {[$w tag ranges sel] == ""} {
  99.     set tk_priv(selectMode) char
  100.     $w mark set anchor $index
  101.     return
  102.     }
  103.     if [tk_textIndexCloser $w $index sel.first sel.last] {
  104.     if {$tk_priv(selectMode) == "char"} {
  105.         $w mark set anchor sel.last
  106.     } else {
  107.         $w mark set anchor sel.last-1c
  108.     }
  109.     } else {
  110.     $w mark set anchor sel.first
  111.     }
  112. }
  113.